home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / sonido / studio.000 / studio / Ss / help.tk < prev    next >
Encoding:
Text File  |  1995-05-11  |  10.4 KB  |  355 lines
  1. #################################
  2. # The Help Module
  3. #
  4. # Part of the SharpeSound Editor
  5. # by Paul D. Sharpe
  6. # A 3rd Year Project at the University of Leeds;
  7. # Department of Electronic and Electrical Engineering.
  8. # Date: 27/2/95
  9. #
  10. # Revision:1
  11. # Date:11/4/95
  12.  
  13. # Set Help globals.
  14. set HELP(BG) snow2
  15. set HELP(FG) black
  16. set HELP(AFG) grey
  17. set HELP(HIL) red
  18. set HELP(COM) DarkGreen
  19. set HELP(UserGuide) $FILE(SRC)/help1.hlp
  20. set HELP(Log) "0"
  21.  
  22.  
  23. ###################################################################
  24. # About
  25. # This procedure is the callback to the Help-About menu item.
  26. # It creates a dialog box giving Credit information about Sound Studio.
  27. proc About {} {
  28.    global DialogCfg
  29.    set Text [format \
  30.        "Sound Studio \n\
  31.       by Paul D. Sharpe\n\n\
  32.     A Sound File Editor for Linux\n\
  33.     Written in TCL/TK (and a little C)\n\n\
  34.     3rd Year Project\n\
  35.     Department of Electronic and Electrical\n Engineering\n\
  36.     University of Leeds\n\n\
  37.     email een2pds@sun.leeds.ac.uk"]
  38.    dialog .about "About Sound Studio" $Text $DialogCfg {info} 0 OK
  39. }
  40.  
  41.  
  42. ###################################################################
  43. # UserManual
  44. # This procedure is the callback to to the Help-User's Manual menu item.
  45. # It creates a pop-up window containing the user's manual, with a few 
  46. # basic highlighting and goto features.
  47. proc UserManual {} {
  48.    global HELP FILE
  49.  
  50.    # Only procede if the help window is non-existant.    
  51.    if {![winfo exists .help]} {
  52.     set HELP(Contents) ""
  53.  
  54.     # Create the toplevel window.
  55.     toplevel .help -bg $HELP(BG)
  56.     # Set the geometry
  57.     wm geometry .help 80x25
  58.     wm title .help "Sound Studio User Guide"
  59.     # Set the Icon information.
  60.     wm iconname .help Help
  61.     wm iconbitmap .help @$FILE(SRC)/help.ico
  62.  
  63.     # Create the buttons panel (Contents, Back, Exit)
  64.     frame .help.buttons -bg $HELP(BG) -relief ridge -bd 4
  65.     # Create the Contents button.
  66.     button .help.buttons.contents\
  67.             -text Contents\
  68.             -bg $HELP(AFG)\
  69.             -fg $HELP(FG)\
  70.             -activeforeground $HELP(FG)\
  71.             -activebackground $HELP(AFG)\
  72.             -width 10\
  73.             -command {.help.help.text yview 0}
  74.     # Create the Back button.
  75.     button .help.buttons.prev\
  76.             -text Back\
  77.             -bg $HELP(AFG)\
  78.             -fg $HELP(FG)\
  79.             -width 10\
  80.             -activebackground $HELP(AFG)\
  81.             -command {
  82.                  set end [expr [llength $HELP(Log)]-1]
  83.                 set value [lindex $HELP(Log) [expr $end-1]]
  84.                 .help.help.text yview $value
  85.                 set HELP(Log) [lreplace $HELP(Log) $end $end]
  86.                     }
  87.     # Create the Exit button.
  88.     button .help.buttons.exit\
  89.             -text Exit\
  90.             -bg $HELP(AFG)\
  91.             -fg $HELP(FG)\
  92.             -activeforeground $HELP(FG)\
  93.             -activebackground $HELP(AFG)\
  94.             -width 10\
  95.             -command {destroy .help}
  96.  
  97.     # Set a variable trace on the Help(Log) variable to ensure that
  98.     # the Back button is disabled when the log is empty.
  99. trace variable HELP(Log) w { if {$HELP(Log)==0} { .help.buttons.prev config -state disabled} else { .help.buttons.prev config -state normal}}
  100.     # Set the current state of the Back button.
  101.     set HELP(Log) $HELP(Log)
  102.  
  103.     # Pack the buttons.
  104.     pack     .help.buttons.contents \
  105.         .help.buttons.prev\
  106.         .help.buttons.exit\
  107.         -side left -anchor w
  108.  
  109.     pack .help.buttons  -anchor w -fill x
  110.  
  111.     # Create and pack the text widget (with scrollbar)
  112.     setupText .help.help
  113.  
  114.     # Load the User's Guide into widget and generate contents list.
  115.     loadFile .help.help.text $HELP(UserGuide)
  116.  
  117.     # Insert the contents list.
  118.     set i 1
  119.     foreach item $HELP(Contents) {
  120.         .help.help.text insert $i.0 [format "[lindex $item 0]\n"]
  121.         .help.help.text tag add content $i.0 "$i.0 lineend"
  122.         incr i
  123.     }
  124.     incr i 2
  125.     # Insert the "Contents" title.
  126.     .help.help.text insert 1.0 [format "Contents\n\n"]
  127.     # Give it the format of a title.
  128.     .help.help.text tag add title 1.0 "1.0 lineend"
  129.     # Store the number of lines added after Contents line.
  130.     set xtraLinesBefore 2
  131.     
  132.     # Add 3 blank lines after contents.
  133.     # This has to be stored for later
  134.     set xtraLinesAfter 3
  135.     .help.help.text insert $i.0 [format "\n\n\n"]
  136.     # Strip the Format code from the Contents list
  137.     forAllMatches .help.help.text / {
  138.         .help.help.text delete first last
  139.         set char [.help.help.text get last "last+ 1 chars"]
  140.         formatText .help.help.text $char 0
  141.     }
  142.     # Configure and Bind content list.
  143.     # A different cursor when above the item
  144.     .help.help.text tag bind content <Any-Enter> \
  145.         ".help.help.text configure -cursor arrow"
  146.     .help.help.text tag bind content <Any-Leave> \
  147.         ".help.help.text configure -cursor {}"
  148.     # Skip to the relevant line.
  149.     .help.help.text tag bind content <Button-1>\
  150.       "set index \[ expr \[lindex \[split \[%W index @%x,%y\] .\] 0\]\
  151.             -(1 +$xtraLinesBefore)\]
  152.        set goto \[expr \[lindex \[lindex \$HELP(Contents) \$index\] 1\] +2\
  153.                +$xtraLinesAfter +\[llength \$HELP(Contents)\]\]
  154.  
  155.         # Store in the log.
  156.        lappend HELP(Log) \$goto
  157.  
  158.        # Adjust the view to the selected line.
  159.        %W yview \$goto"
  160.    } else {
  161.     # Bring  the user manual to the front.
  162.     # I am not using raise since it doesn't generally work for olwm.
  163.     wm withdraw .help
  164.     wm deiconify .help
  165.    }
  166. }
  167.  
  168. ###################################################################
  169. # setupText
  170. # This procedure creates a text widget and scroll bar.
  171. # The parameter "w" is a path for the combined widget.
  172. proc setupText {w} {
  173.    global HELP
  174.  
  175.    #Create Widgets if the path name is valid.
  176.    if {![winfo exists $w]} {
  177.     # Create the general frame.
  178.     frame $w
  179.  
  180.     # Create the text widget.
  181.     # The configuration option "setgrid" sets up gridded 
  182.     # window management.
  183.     text $w.text     -yscrollcommand "$w.scroll set"\
  184.             -setgrid 1 \
  185.             -wrap word
  186.     # Create the scrollbar.
  187.     scrollbar $w.scroll -command "$w.text yview"
  188.  
  189.     # Pack the widget.
  190.     pack $w.text  -fill both -expand 1 -side left
  191.     pack $w.scroll -side left -fill y -expand 1
  192.     pack $w -fill both -expand 1
  193.    }
  194.  
  195.    # Configure the Widgets.
  196.    $w config -bg $HELP(BG)
  197.    $w.text config\
  198.         -background $HELP(BG)\
  199.         -foreground $HELP(FG)\
  200.         -cursor {}\
  201.         -font -adobe-helvetica-medium-r-normal--12-120-*\
  202.         -exportselection 0
  203.  
  204.    $w.scroll config -background $HELP(BG)\
  205.         -foreground $HELP(AFG)
  206.  
  207.    # Remove the default bindings that make the text widget editable.
  208.    bind $w.text <Any-KeyPress> { }
  209.    bind $w.text <Any-Button> { }
  210.    bind $w.text <Any-B1-Motion> { }
  211.  
  212.    # Set the configuration for text tags.
  213.    # Underline.
  214.    $w.text tag configure underline -underline 1
  215.    # Command
  216.    $w.text tag configure command \
  217.         -foreground DarkGreen\
  218.         -font -adobe-helvetica-medium-r-normal--14-140-*
  219.    $w.text tag bind command <Button-1> { 
  220.         puts [%W get "@%x,%y wordstart" "@%x,%y wordend"] }
  221.    $w.text tag bind command <Any-Enter> "$w.text configure -cursor arrow"
  222.    $w.text tag bind command <Any-Leave> "$w.text configure -cursor {}"
  223.    # Content
  224.    $w.text tag configure content \
  225.         -foreground DarkGreen \
  226.         -font -adobe-helvetica-medium-r-normal--14-140-*
  227.    # Title.
  228.    $w.text tag configure title -font -adobe-helvetica-medium-r-normal--24-240-*
  229.    # Italic
  230.    $w.text tag configure italic -font -adobe-helvetica-medium-o-normal--12-120-*
  231.    # Highlight.
  232.    $w.text tag configure highlight -foreground red
  233. }
  234.  
  235.  
  236. ###################################################################
  237. # loadFile
  238. # This procedure load a text file given by "file" formatted with a 
  239. # simple form of hyper-text into the text widget given by "w". And
  240. # format it.
  241. proc loadFile {w file} {
  242.    # Delete all previous text in the text widget.
  243.    $w delete 1.0 end
  244.  
  245.    # Open the text file.
  246.    set f [open $file]
  247.  
  248.    # Insert the text into the text widget.
  249.    while {![eof $f]} {
  250.     $w insert end [read $f 1000]
  251.    }
  252.     
  253.    # Close the text file.
  254.    close $f
  255.  
  256.    # Format the text. This is done by looking for all the "/" in the
  257.    # text widget, deleting it and sending the following character to
  258.    # the procedure formaText, which tags the text appropriately.
  259.     forAllMatches $w / {
  260.         $w delete first last
  261.         set char [$w get last "last+ 1 chars"]
  262.         formatText $w $char
  263.     }
  264. }
  265.  
  266. ###################################################################
  267. # forAllMatches
  268. # This procedure takes three arguments: the name of a text widget, 
  269. # a regular expression pattern and a script. 
  270. # It finds all of the ranges of characters that match the pattern. 
  271. # For each matching range forAllMatches sets the marks first and last 
  272. # to the beginning and end of the of the range, then it invokes the 
  273. # script.
  274. # This procedure has been taken from John K. Ousterhout's book,
  275. # Tcl and the Tk Toolkit (1994) p.219. 
  276. proc forAllMatches {w pattern script} {
  277.     scan [$w index end] %d numLines
  278.     for {set i 1} {$i<=$numLines} {incr i } {
  279.        $w mark set last $i.0
  280.        while {[regexp -indices $pattern \
  281.           [$w get last "last lineend" ] indices ] } {
  282.         $w mark set first "last + [lindex $indices 0] chars"
  283.         $w mark set last "last + 1 chars +[lindex $indices 1] chars"
  284.         uplevel $script
  285.        }
  286.     }
  287. }
  288. ###################################################################
  289. # formatText
  290. # This procedure tags the text in a text widget (if format is true),
  291. # based on the character in "char". 
  292. # Text Marks "first" and "last" need to have been set prior to calling 
  293. # the procedure. These mark the range of characters to be tagged.
  294. # The parameters are as follows:
  295. # w    : is the path of the text widget.
  296. # char  : is the character determining which tag is to be set.
  297. #       The current valid characters are:
  298. #        u  : underline
  299. #        i  : italic
  300. #        c  : command
  301. #        Cn : Content item, n is a positive integer. 
  302. #        t  : title
  303. #        h  : highlight
  304. #        /  : keep the / character.        
  305. # format : is a boolean value, which when true causes the text to be formatted.
  306. #         when false it removes all format information from the text
  307. #       without tagging
  308. proc formatText { w char {format 1} } {
  309.    global HELP
  310.  
  311.    # Format the text.
  312.    if {$format} {
  313.     switch $char {
  314.         u {     $w delete last "last + 1 chars"
  315.             $w tag add underline "last" "last wordend"
  316.           }
  317.         / {     $w insert first / }
  318.         c {     $w delete last "last + 1 chars"
  319.             $w tag add command "last" "last wordend"
  320.           }
  321.         C {    
  322.             set tab ""
  323.             set tabs [$w get "last + 1 chars" "last + 2 chars"]
  324.             $w delete last "last + 2 chars"
  325.             while {$tabs} {set tab "$tab      " ; incr tabs -1}
  326.             lappend HELP(Contents)\
  327.              [list "$tab[$w get "first" "first lineend"]" \
  328.                 [$w index first]]
  329.           }
  330.         t {     $w delete last "last + 1 chars"
  331.             $w tag add title "last" "last lineend"
  332.           }
  333.         h {    $w delete last "last + 1 chars"
  334.             $w tag add highlight "last" "last wordend"
  335.           }
  336.         i {    $w delete last "last + 1 chars"
  337.             $w tag add italic "last" "last wordend"
  338.           }
  339.     default { }
  340.     }
  341.  
  342.    # Remove all format data without formatting.
  343.    }  else {
  344.     set ok 0
  345.     foreach i {u c C t h i} {
  346.         if {$i==$char} { 
  347.             $w delete last "last + 1 chars"
  348.             set ok 1 
  349.         }
  350.     }
  351.         if {!$ok} { $w insert last / }
  352.   }
  353. }
  354.  
  355.